Celestin Apprentice 5

home *** CD-ROM | disk | FTP | other *** search

/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Applications / NIH Image 1.60 / 1.60 Source / Image.p < prev next >

Wrap

Text File | 1996-03-11 | 72.8 KB | 2,831 lines | [TEXT/PJMM]

program Image; {NIH Image is a public domain program for the Macintosh for acquiring, } {processing, analyzing, editing, printing, and animating 8-bit images.} {Version 1.60, 2 Feb 1996} {Developed using Metrowerks CodeWarrior CW8 PPC and 68K Pascal compilers.} {Author :} {Wayne Rasband} {National Institutes of Health} {email: wayne@helix.nih.gov} {WWW: http://rsb.info.nih.gov/nih-image/} {Anonymous FTP: zippy.nimh.nih.gov} {Phone: 301-496-4957} uses Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows, OSUtils, Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes, Devices, Balloons, AppleEvents, DiskInit, EPPC, SegLoad, Globals, Utilities, Init, File1, File2, Analysis, Graphics, Edit, Filters, Camera, User, Macros1, Macros2, Stacks, Background, Lut, Projection, Plugins, Text, Math, Registration, {Profiler,} fft; {Turn off automatic toolbox initialization.} {$I-} {PROCEDURE MacsBug; inline $a9ff;} procedure UpdateOptionsMenu; var CheckIt: boolean; i: integer; begin with info^ do begin CheckItem(OptionsMenuH, GrayscaleItem, (LutMode = Grayscale) or (LutMode = CustomGrayscale)); if LutMode <> PseudoColor then ColorTable := CustomTable; CheckItem(ColorTablesMenuH, SystemPaletteItem, ColorTable = AppleDefault); CheckItem(ColorTablesMenuH, Pseudo20Item, ColorTable = Pseudo20); CheckItem(ColorTablesMenuH, Pseudo32Item, ColorTable = Pseudo32); CheckItem(ColorTablesMenuH, RainbowItem, ColorTable = Rainbow); CheckItem(ColorTablesMenuH, Fire1Item, ColorTable = Fire1); CheckItem(ColorTablesMenuH, Fire2Item, ColorTable = Fire2); CheckItem(ColorTablesMenuH, IceItem, ColorTable = Ice); CheckItem(ColorTablesMenuH, GraysItem, ColorTable = Grays); CheckItem(ColorTablesMenuH, SpectrumItem, ColorTable = Spectrum); SetMenuItem(OptionsMenuH, ScaleToFitItem, info <> NoInfo); CheckIt := ScaleToFitWindow; CheckItem(OptionsMenuH, ScaleToFitItem, CheckIt); CheckItem(OptionsMenuH, ThresholdItem, Thresholding); CheckItem(OptionsMenuH, SliceItem, DensitySlicing); SetMenuItem(OptionsMenuH, PropagateItem, nPics > 1); end; end; procedure UpdateProcessMenu; var ShowItems: boolean; i: integer; str: str255; begin ShowItems := Info <> NoInfo; for i := SmoothItem to FilterItem do SetMenuItem(ProcessMenuH, i, ShowItems); with info^ do if (LutMode = GrayScale) or (LutMode = CustomGrayscale) or DensitySlicing then SetMenuItemText(ProcessMenuH, ApplyItem, 'Apply LUT') else SetMenuItemText(ProcessMenuH, ApplyItem, 'Convert to Grayscale'); if CurrentWindow = TextKind then SetMenuItemText(ProcessMenuH, ConvolveItem, 'Convolve') else SetMenuItemText(ProcessMenuH, ConvolveItem, 'Convolve…'); for i := BinaryItem to FixColorsItem do SetMenuItem(ProcessMenuH, i, ShowItems); NumToString(BinaryCount, str); str := concat('Set Count[', str, ']…'); SetMenuItemText(BinaryMenuH, SetCountItem, str); NumToString(BinaryIterations, str); str := concat('Set Iterations[', str, ']…'); SetMenuItemText(BinaryMenuH, IterationsItem, str); CheckItem(BackgroundMenuH, FasterItem, FasterBackgroundSubtraction); NumToString(BallRadius, str); str := concat('Set Radius[', str, ']…'); SetMenuItemText(BackgroundMenuH, RadiusItem, str); end; procedure UpdateSpecialMenu; var ShowItems: boolean; begin ShowItems := Info <> NoInfo; SetMenuItem(SpecialMenuH, SaveBlankFieldItem, ShowItems); SetMenuItem(SpecialMenuH, PhotoModeItem, ShowItems); if CurrentWindow = TextKind then SetMenuItemText(SpecialMenuH, LoadMacrosItem, 'Load Macros from Window') else SetMenuItemText(SpecialMenuH, LoadMacrosItem, 'Load Macros…') end; procedure UpdateStacksMenu; var ShowItems: boolean; isStack: boolean; begin ShowItems := Info <> NoInfo; SetMenuItem(StacksMenuH, StackFromWindowsItem, nPics > 0); isStack := info^.StackInfo <> nil; SetMenuItem(StacksMenuH, WindowsFromStackItem, isStack); SetMenuItem(StacksMenuH, AddSliceItem, isStack); SetMenuItem(StacksMenuH, DeleteSliceItem, isStack); SetMenuItem(StacksMenuH, NextSliceItem, isStack); SetMenuItem(StacksMenuH, PreviousSliceItem, isStack); SetMenuItem(StacksMenuH, MakeMovieItem, ShowItems); SetMenuItem(StacksMenuH, CaptureFramesItem, ShowItems); SetMenuItem(StacksMenuH, AnimateItem, isStack); SetMenuItem(StacksMenuH, AverageSlicesItem, isStack); SetMenuItem(StacksMenuH, MakeMontageItem, isStack); SetMenuItem(StacksMenuH, RegisterItem, isStack); SetMenuItem(StacksMenuH, CaptureColorItem, ShowItems); SetMenuItem(StacksMenuH, RGBToColorItem, isStack); SetMenuItem(StacksMenuH, ColorToRGBItem, ShowItems and (not isStack)); SetMenuItem(StacksMenuH, RGBToHSVItem, isStack); SetMenuItem(StacksMenuH, ProjectItem, isStack); SetMenuItem(StacksMenuH, ResliceItem, isStack); SetMenuItem(StacksMenuH, StackInfoItem, isStack); end; function AboutFilter (d: DialogPtr; var event: EventRecord; var ItemHit: integer): boolean; { simple filter proc for about box -- must be at top level! % } begin if (event.what in [MouseDown, KeyDown, AutoKey]) then begin AboutFilter := true; ItemHit := OK; end else begin AboutFilter := false; ItemHit := 0; end; end; procedure AboutUProc (d: DialogPtr; item: integer); { About box user proc -- must be at top level!} var s: str255; saveport: grafptr; VersInfo: str255; begin getport(saveport); setport(d); if (item = MemItem) then begin NumToString(FreeMem div 1024, s); s := concat(s, 'K free'); DrawSItem(MemItem, Geneva, 9, d, s); end else if (item = VersItem) then begin RealToString(version / 100.0, 4, 2, VersInfo); VersInfo := concat('Version ', VersInfo); DrawSItem(VersItem, Geneva, 9, d, VersInfo); end; setport(saveport); end; procedure DoAbout; {About Box by David Powell} var i: integer; d: dialogptr; midscreen: point; r: rect; h: handle; itype: integer; begin if AboutBoxFilterProc=nil then AboutBoxFilterProc:=NewRoutineDescriptor(@AboutFilter, uppModalFilterProcInfo, GetCurrentISA); if AboutBoxUserProc=nil then AboutBoxUserProc:=NewRoutineDescriptor(@AboutUProc, uppUserItemProcInfo, GetCurrentISA); d := getnewdialog(AboutID, nil, pointer(-1)); if (d <> nil) then begin SetPort(d); GetDialogItem(d, VersItem, itype, h, r); SetDialogItem(d, VersItem, itype, handle(AboutBoxUserProc), r); GetDialogItem(d, MemItem, itype, h, r); SetDialogItem(d, MemItem, itype, handle(AboutBoxUserProc), r); ShowWindow(d); repeat ModalDialog(AboutBoxFilterProc, i); until (i = OK); DisposeDialog(d); FlushEvents(EveryEvent, 0); end; end; procedure DoPreferences; const BufferSizeID = 4; ScaleConvolutionsID = 6; InvertValuesID = 7; InvertYID = 8; SwitchingID = 9; HighlightID = 10; CreatorID = 12; OscillatingID = 14; FriendlyID = 15; var mylog: DialogPtr; item, i: integer; SaveScaleC: boolean; SaveInvertValues, SaveInvertY, SaveMovies, NewFriendlyMode, okay: boolean; SaveBufferSize: LongInt; SaveCreator: packed array[1..4] of char; tCreator:str255; SaveInfo:InfoPtr; begin InitCursor; if isInvertingFunction then InvertPixelValues:=true; SaveBufferSize := BufferSize; SaveInvertY := InvertYCoordinates; SaveScaleC := ScaleConvolutions; SaveCreator := TextCreator; SaveMovies := OscillatingMovies; NewfriendlyMode := LutFriendlyMode; mylog := GetNewDialog(6000, nil, pointer(-1)); SetDNum(MyLog, BufferSizeID, BufferSize div 1024); SetDlogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions)); SetDlogItem(mylog, InvertYID, ord(InvertYCoordinates)); SetDlogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend)); SetDlogItem(mylog, HighlightID, ord(HighlightMode)); SetDlogItem(mylog, OscillatingID, ord(OscillatingMovies)); SetDlogItem(mylog, FriendlyID, ord(LutFriendlyMode)); SaveInvertValues := InvertPixelValues; if InvertPixelValues then SetDlogItem(mylog, InvertValuesID, 1); tCreator:='1234'; tCreator[1]:=TextCreator[1]; tCreator[2]:=TextCreator[2]; tCreator[3]:=TextCreator[3]; tCreator[4]:=TextCreator[4]; SetDString(mylog, CreatorID, tCreator); repeat ModalDialog(nil, item); if item = BufferSizeID then begin BufferSize := GetDNum(MyLog, BufferSizeID) * 1024; if BufferSize < 1 then begin beep; BufferSize := 1; SetDNum(MyLog, BufferSizeID, BufferSize); end; end; if item = ScaleConvolutionsID then begin ScaleConvolutions := not ScaleConvolutions; SetDlogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions)); end; if item = InvertValuesID then begin InvertPixelValues := not InvertPixelValues; SetDlogItem(mylog, InvertValuesID, ord(InvertPixelValues)); end; if item = InvertYID then begin InvertYCoordinates := not InvertYCoordinates; SetDlogItem(mylog, InvertYID, ord(InvertYCoordinates)); end; if item = SwitchingID then begin SwitchLUTOnSuspend := not SwitchLUTOnSuspend; SetDlogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend)); end; if item = HighlightID then begin HighlightMode := not HighlightMode; SetDlogItem(mylog, HighlightID, ord(HighlightMode)); LoadLUT(info^.ctable); end; if item = CreatorID then begin tCreator := GetDString(mylog, item); if length(tCreator)=4 then begin TextCreator[1]:=tCreator[1]; TextCreator[2]:=tCreator[2]; TextCreator[3]:=tCreator[3]; TextCreator[4]:=tCreator[4]; end; end; if item = OscillatingID then begin OscillatingMovies := not OscillatingMovies; SetDlogItem(mylog, OscillatingID, ord(OscillatingMovies)); end; if item = FriendlyID then begin NewFriendlyMode := not NewFriendlyMode; SetDlogItem(mylog, FriendlyID, ord(NewFriendlyMode)); end; until (item = ok) or (item = cancel); DisposeDialog(mylog); if item = cancel then begin BufferSize := SaveBufferSize; ScaleConvolutions := SaveScaleC; InvertYCoordinates := SaveInvertY; OscillatingMovies := SaveMovies; if PasteControl <> nil then DrawPasteControl; TextCreator := SaveCreator; end else with info^ do begin if InvertPixelValues then begin SaveInfo:=info; for i := 1 to nPics do begin Info := pointer(WindowPeek(PicWindow[i])^.RefCon); if info^.fit=uncalibrated then InvertGrayLevels end; {for} info:=SaveInfo; end else if (InvertPixelValues = false) and SaveInvertValues then begin SaveInfo:=info; for i := 1 to nPics do begin Info := pointer(WindowPeek(PicWindow[i])^.RefCon); if isInvertingFunction then RemoveDensityCalibration; end; {for} info:=SaveInfo; end; end; if BufferSize <> SaveBufferSIze then begin PutError('You must quit and restart NIH Image before the Undo and Clipboard buffer size change will take effect.'); SaveSettings; end; if (NewFriendlyMode <> LutFriendlyMode) then begin if (not LutFriendlyMode) and (ScreenDepth = 8) then begin SaveInfo := Info; Info := noInfo; okay := LoadCLUTResource(AppleDefaultCLUT); Info := SaveInfo; end; LutFriendlyMode := NewFriendlyMode; if ScreenDepth <= 8 then RestoreScreen; UpdateLUT; end; end; procedure UpdateWindowsMenu; var i, n: integer; begin for i := NextImageItem to TileImagesItem do SetMenuItem(WindowsMenuH, i, nPics > 1); for i := SelectToolsItem to SelectResultsItem do CheckItem(WindowsMenuH, i, false); SetMenuItem(WindowsMenuH, SelectHistogramItem, HistoWindow <> nil); SetMenuItem(WindowsMenuH, SelectPlotItem, PlotWindow <> nil); SetMenuItem(WindowsMenuH, SelectResultsItem, ResultsWindow <> nil); for i := 1 to nTextWindows do CheckItem(WindowsMenuH, WindowsMenuItems - 1 + i, false); for i := 1 to nPics do CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + i, false); if PasteControl = nil then SetMenuItemText(WindowsMenuH, PasteControlItem, 'Show Paste Control') else SetMenuItemText(WindowsMenuH, PasteControlItem, 'Hide Paste Control'); if CurrentKind < 0 then exit(UpdateWindowsMenu); {System Window} case CurrentKind of ToolKind: CheckItem(WindowsMenuH, SelectToolsItem, true); MapKind: CheckItem(WindowsMenuH, SelectGrayMapItem, true); LUTKind: CheckItem(WindowsMenuH, SelectLutItem, true); InfoKind: CheckItem(WindowsMenuH, SelectInfoItem, true); HistoKind: CheckItem(WindowsMenuH, SelectHistogramItem, true); ProfilePlotKind, CalibrationPLotKind: CheckItem(WindowsMenuH, SelectPlotItem, true); ResultsKind: CheckItem(WindowsMenuH, SelectResultsItem, true); TextKind: begin if TextInfo <> nil then CheckItem(WindowsMenuH, WindowsMenuItems - 1 + TextInfo^.WindowNum, true); end; PicKind: CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + info^.PicNum, true); otherwise end; end; procedure CloseAll; FORWARD; procedure DoNew; const ImageID = 4; TextID = 5; WidthID = 6; HeightID = 7; TitleID = 8; var mylog: DialogPtr; item, i: integer; SaveWidth, SaveHeight: integer; SaveTitle: string[31]; okay, OpenImage: boolean; procedure SetButtons; begin SetDlogItem(mylog, ImageID, ord(OpenImage)); SetDlogItem(mylog, TextID, ord(not OpenImage)); end; begin InitCursor; OpenImage := true; SaveWidth := NewPicWidth; SaveHeight := NewPicHeight; SaveTitle := NewTitle; mylog := GetNewDialog(180, nil, pointer(-1)); SetButtons; SetDNum(MyLog, WidthID, NewPicWidth); SelectdialogItemText(MyLog, WidthID, 0, 32767); SetDNum(MyLog, HeightID, NewPicHeight); SetDString(MyLog, TitleID, NewTitle); repeat ModalDialog(nil, item); if item = ImageID then begin OpenImage := true; SetButtons; end; if item = TextID then begin OpenImage := false; SetButtons; end; if item = WidthID then begin NewPicWidth := GetDNum(MyLog, WidthID); if (NewPicWidth < 0) or (NewPicWidth > MaxPicSize) then begin NewPicWidth := SaveWidth; SetDNum(MyLog, WidthID, NewPicWidth); end; end; if item = HeightID then begin NewPicHeight := GetDNum(MyLog, HeightID); if (NewPicHeight < 0) or (NewPicHeight > MaxPicSize) then begin NewPicHeight := SaveHeight; SetDNum(MyLog, HeightID, NewPicHeight); end; end; until (item = ok) or (item = cancel); if item = ok then NewTitle := GetDString(MyLog, TitleID); DisposeDialog(mylog); if NewPicWidth < 32 then NewPicWidth := 32; if NewPicHeight < 16 then NewPicHeight := 16; if item = cancel then begin NewPicWidth := SaveWidth; NewPicHeight := SaveHeight; NewTitle := SaveTitle; exit(DoNew); end; if OpenImage then begin okay := NewPicWindow(NewTitle, NewPicWidth, NewPicHeight); if okay then if info^.PixMapSize > UndoBufSize then PutWarning; end else okay := MakeNewTextWindow(NewTitle, 500, 400); end; procedure DoMenuEvent (MenuChoice: LongInt); var MenuID, MenuItem, i, ignore: integer; name, str: str255; dna, RefNum: integer; ItemName: str255; FontName: str255; ok, isSelection: boolean; NewStyle: StyleItem; t: FateTable; {Only needed for MakeSkeleton} SaveBFInfo: InfoPtr; err: OSErr; begin MenuID := HiWrd(MenuChoice); MenuItem := LoWrd(MenuChoice); case MenuID of AppleMenu: begin if MenuItem = 1 then DoAbout else begin GetMenuItemText(GetMenuHandle(AppleMenu), MenuItem, name); ignore := OpenDeskAcc(name) end; end; FileMenu: begin StopDigitizing; isInsertionPoint := false; case MenuItem of NewItem: DoNew; OpenItem: ok := DoOpen('', 0); ImportItem: ok := ImportFile('', 0); {-} CloseItem: if OptionKeyWasDown and (CurrentWindow <> TextKInd) then CloseAll else DoClose; SaveItem: if OptionKeyWasDown and (info^.StackInfo = nil) and (CurrentWindow <> TextKind) then SaveAll else SaveFile; SaveAsItem: case CurrentWindow of TextKind: SaveTextAs; ResultsKind: Export('', 0); otherwise SaveAs('', 0); end; ExportItem: Export('', 0); {-} RecordPreferencesItem: SaveSettings; RevertItem: with info^ do if DataType = EightBits then RevertToSaved else RescaleToEightBits; DuplicateItem: ok := Duplicate('', false); GetInfoItem: GetInfo; {-} PageSetupItem: if OptionKeyDown then SetHalftone else DoPageSetup; PrintItem: Print(true); {-} QuitItem: finished := true; end; if OpeningRGB then begin ConvertRGBToEightBitColor(true); OpeningRGB := false; end; end; AcquireMenu: RunAcqPlugIn(MenuItem); ExportMenu: RunExportPlugIn(MenuItem); EditMenu: begin StopDigitizing; GetMenuItemText(GetMenuHandle(EditMenu), MenuItem, ItemName); if not SystemEdit(MenuItem - 1) then case MenuItem of UndoItem: DoUndo; {-} CutItem: DoCut; CopyItem: DoCopy; PasteItem: DoPaste; ClearItem: DoClear; {-} FillItem: if CurrentWindow = TextKind then DoFind else SetupOperation(FillItem); InvertItem, DrawBoundaryItem: SetupOperation(MenuItem); DrawScaleItem: DrawScale; {-} SelectAllItem: with info^ do if CurrentWindow = TextKind then SelectAllText else if RoiShowing and EqualRect(RoiRect, PicRect) then KillRoi else SelectAll(true); DeselectItem: KillRoi; ScaleAndRotateItem: ScaleAndRotate; {-} RotateLeftItem: Rotate(RotateLeft); RotateRightItem: Rotate(RotateRight); FlipVerticalItem: FlipOrRotate(FlipVertical); FlipHorizontalItem: FlipOrRotate(FlipHorizontal); {-} UnzoomItem: Unzoom; ShowClipboardItem: ShowClipboard; end; end; OptionsMenu: begin case MenuItem of GrayscaleItem: ResetGrayMap; LutOptionsItem: DoLutOptions; {-} PreferencesItem: DoPreferences; PlotOptionsItem: DoProfilePlotOptions; ScaleToFitItem: ScaleToFit; ThresholdItem: begin if DensitySlicing then DisableDensitySlice; if Info^.Thresholding then DisableThresholding else begin SetupLutUndo; AutoThreshold; end; end; SliceItem: if DensitySlicing then DisableDensitySlice else begin if info^.thresholding then DisableThresholding; EnableDensitySlice; end; end; end; ColorTablesMenu: SwitchColorTables(MenuItem, true); FontMenu: begin GetMenuItemText(FontMenuH, MenuItem, FontName); GetFNum(FontName, CurrentFontID); DisplayText(true); if CurrentWindow = TextKind then ChangeFontOrSize; end; SizeMenu: begin case MenuItem of 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12: CurrentSize := GetFontSize(MenuItem); end; DisplayText(true); if IsInsertionPoint then UpdatePicWindow; if CurrentWindow = TextKind then ChangeFontOrSize; end; StyleMenu: begin case MenuItem of 1: CurrentStyle := []; 2, 3, 4, 5, 6: begin case MenuItem of TxBold: NewStyle := Bold; TxItalic: NewStyle := Italic; TxUnderLine: NewStyle := Underline; TxOutLine: NewStyle := Outline; TxShadow: NewStyle := Shadow; end; if NewStyle in CurrentStyle then CurrentStyle := CurrentStyle - [NewStyle] else CurrentStyle := CurrentStyle + [NewStyle]; end; LeftItem: TextJust := teJustLeft; CenterItem: TextJust := teJustCenter; RightItem: TextJust := teJustRight; NoBackgroundItem: TextBack := NoBack; WithBackgroundItem: TextBack := WithBack; end; {case} DisplayText(true); end; PropagateMenu: DoPropagate(MenuItem); ProcessMenu: begin StopDigitizing; SetupUndo; case MenuItem of SmoothItem: if OptionKeyDown then Filter(UnweightedAvg, 0, t) else Filter(WeightedAvg, 0, t); SharpenItem: Filter(fsharpen, 0, t); ShadowItem: DoShadowFilter; FindEdgesItem: Filter(FindEdges, 0, t); RankItem: DoRankFilter; DitherItem: Filter(Dither, 0, t); ConvolveItem: if CurrentWindow = TextKind then ConvolveUsingText else Convolve('', 0); {-} ImageMathItem: DoImageMath; ApplyItem: if CheckCalibration then ApplyLookupTable; EnhanceItem: EnhanceContrast; EqualizeItem: EqualizeHistogram; FixColorsItem: if not isBinaryImage then FixColors; end; end; FilterMenu: RunFilterPlugin(menuItem); BinaryMenu: case MenuItem of MakeBinaryItem: MakeBinary; ErosionItem: DoErosion; DilationItem: DoDilation; OpeningItem: DoOpening; ClosingItem: DoClosing; SetCountItem: SetBinaryCount; IterationsItem: SetIterations; OutlineItem: filter(OutlineFilter, 0, t); SkeletonizeItem: MakeSkeleton; end; ArithmeticMenu: DoArithmetic(MenuItem, 0); fftMenu: case MenuItem of ForewardFFTItem: doFFT(ForewardFFT); InverseFFTItem: doFFT(InverseFFTWithMask); RedisplayItem: RedisplayPowerSpectrum; SwapItem: doSwapQuadrants; end; BackgroundMenu: DoBackgroundMenuEvent(MenuItem); AnalyzeMenu: begin if MenuItem <> HistogramItem then StopDigitizing; SetupUndo; case MenuItem of MeasureItem: Measure; AnalyzeItem: AnalyzeParticles; ShowItem: ShowResults; OptionsItem: DoMeasurementOptions; HistogramItem: DoHistogram; PlotItem: PlotDensityProfile; PlotSurfaceItem: PlotSurface; {-} SetScaleItem: SetScale; CalibrateItem: Calibrate; RedoItem: RedoMeasurement; DeleteItem: DeleteMeasurement; ResetItem: ResetCounter; RestoreItem: RestoreRoi; MarkItem: MarkSelection(mCount); end; end; SpecialMenu: begin case MenuItem of StartItem: StartDigitizing; AverageItem: AverageFrames; SaveBlankFieldItem: begin SaveBFInfo := BlankFieldInfo; BlankFieldInfo := nil; {Prevents shading correction.} StopDigitizing; BlankFieldInfo := SaveBFInfo; SaveBlankField; end; VideoControlItem: ShowVideoDialog; PhotoModeItem: PhotoMode; LoadMacrosItem: begin LoadMacros; {$ifc not PowerPC} UnloadSeg(@LoadMacros); {$endc} end; otherwise if MenuItem >= FirstMacroItem then RunMacro(MenuItem - FirstMacroItem + 1); {if MenuItem >= FirstMacroItem then begin if ProfilerInit(collectDetailed, bestTimeBase, 50, 25) = noErr then begin RunMacro(MenuItem - FirstMacroItem + 1); err := ProfilerDump('Image.prof'); ProfilerTerm; end; end;} end; end; StacksMenu: begin StopDigitizing; case MenuItem of StackFromWindowsItem: MakeStack; WindowsFromStackItem: MakeWindowsFromStack; AddSliceItem: ok := AddSlice(true); DeleteSliceItem: DeleteSlice; NextSliceItem, PreviousSliceItem: ShowNextSlice(MenuItem); MakeMovieItem: MakeMovie(true); CaptureFramesItem: CaptureFrames; AnimateItem: Animate; AverageSlicesItem: AverageSlices; MakeMontageItem: MakeMontage; CaptureColorItem: CaptureColor; RGBToColorItem: ConvertRGBToEightBitColor(false); ColorToRGBItem: ConvertEightBitColorToRGB; RGBToHSVItem: ConvertRGBToHSV; RegisterItem: DoRegister; ProjectItem: Project; ResliceItem: Reslice; StackInfoItem: DoStackInfo; otherwise beep end; end; WindowsMenu: begin if MenuItem <> PasteControlItem then StopDigitizing; case MenuItem of NextImageItem: ShowNextImage; CascadeImagesItem: CascadeImages; TileImagesItem: TileImages; PasteControlItem: if PasteControl = nil then ShowPasteControl else ignore := CloseAWindow(PasteControl); {-} SelectToolsItem: SelectWindow(ToolWindow); SelectGrayMapItem: SelectWindow(MapWindow); SelectLutItem: SelectWindow(LUTWindow); SelectInfoItem: SelectWindow(InfoWindow); SelectHistogramItem: if HistoWindow <> nil then SelectWindow(HistoWindow); SelectPlotItem: if PlotWindow <> nil then SelectWindow(PlotWindow); SelectResultsItem: if ResultsWindow <> nil then SelectWindow(ResultsWindow); {-} otherwise if MenuItem <= (WindowsMenuItems - 1 + nTextWindows) then SelectWindow(TextWindow[MenuItem - (WindowsMenuItems - 1)]) else SelectWindow(PicWindow[MenuItem - (WindowsMenuItems + nTextWindows)]); end; end; UserMenu: DoUserMenuEvent(MenuItem); otherwise end; HiliteMenu(0); RoiUpdateTime := 0; end; procedure DoFreehand; var finish: point; event: EventRecord; wright, wbottom: integer; b: boolean; begin SetPort(info^.wptr); PenPat(AntPattern[PatIndex]); PenSize(1, 1); with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; while Button do begin GetMouse(finish); with finish do begin if h < 0 then h := 0; if v < 0 then v := 0; if h > wright then h := wright; if v > wbottom then v := wbottom; if (xCoordinates^[nCoordinates] <> h) or (yCoordinates^[nCoordinates] <> v) then begin if nCoordinates < MaxCoordinates then nCoordinates := nCoordinates + 1 else beep; LineTo(h, v); xCoordinates^[nCoordinates] := h; yCoordinates^[nCoordinates] := v; wait(1); end; {if mouse has moved} end; {with} end; {while Button} end; procedure DoPolygon (start: point); var Finish, OldFinish: point; finished, DoubleClick, done: boolean; ticks, MouseUpTime, LastMouseUpTime: LongInt; wright, wbottom: integer; StartRect: rect; MouseDown, MouseUpEvent: boolean; begin DrawLabels('DX:', 'DY:', 'Length:'); SetPort(info^.wptr); PenMode(PatXor); PenSize(1, 1); if CurrentTool = PolygonTool then begin Pt2Rect(Start, Start, StartRect); InsetRect(StartRect, -4, -4); FrameRect(StartRect); end else SetRect(StartRect, 0, 0, 0, 0); finish := start; finished := false; with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; MouseUpTime := 0; done := false; MouseUpEvent := false; MouseDown := button; repeat ShowDxDy(0, 0); repeat OldFinish := finish; GetMouse(finish); with finish do begin if h < 0 then begin h := 0; done := CurrentTool = LineTool; end; if v < 0 then begin v := 0; done := CurrentTool = LineTool; end; if h > wright then begin h := wright; done := CurrentTool = LineTool; end; if v > wbottom then begin v := wbottom; done := CurrentTool = LineTool; end; end; if not EqualPt(finish, OldFinish) then begin ticks := TickCount; repeat until TickCount <> ticks; MoveTo(start.h, start.v); LineTo(OldFinish.h, OldFinish.v); MoveTo(start.h, start.v); LineTo(finish.h, finish.v); ShowDxDy(abs(finish.h - start.h), abs(finish.v - start.v)); end; if button <> MouseDown then begin MouseUpEvent := not button; MouseDown := button; end; until MouseUpEvent; MouseUpEvent := false; LastMouseUpTime := MouseUpTime; MouseUpTime := TickCount; DoubleClick := ((MouseUpTime - LastMouseUpTime) < GetDblTime) and EqualPt(start, finish); if nCoordinates < MaxCoordinates then nCoordinates := nCoordinates + 1 else beep; xCoordinates^[nCoordinates] := finish.h; yCoordinates^[nCoordinates] := finish.v; start := finish; Finished := (PtInRect(finish, StartRect) or DoubleClick or done) and (nCoordinates > 2); until finished; FlushEvents(EveryEvent, 0); end; procedure MakePolygon (event: EventRecord); var Start: point; i: integer; begin with info^ do begin start := event.where; SetPort(wptr); PenNormal; xCoordinates^[1] := Start.h; yCoordinates^[1] := Start.v; nCoordinates := 1; MoveTo(start.h, start.v); case CurrentTool of FreehandTool: begin DoFreehand; with Start do LineTo(h, v); end; PolygonTool: DoPolygon(start); end; if nCoordinates > 2 then begin ConvertCoordinates; if CurrentTool = PolygonTool then MakeOutline(PolygonRoi) else MakeOutline(FreehandRoi); end else begin KillRoi; UpdatePicWindow; end; end; {with} end; procedure MakeLineRoi (event: EventRecord); var Start: point; begin if NoUndo then exit(MakeLineRoi); start := event.where; with Info^ do begin WhatToUndo := NothingToUndo; measuring := false; if LOIType = Straight then begin DoObject(LineObj, event); RoiType := LineRoi; MakeRegion; RoiShowing := true; SetupUndo; exit(MakeLineRoi); end; SetPort(wptr); PenNormal; MoveTo(start.h, start.v); xCoordinates^[1] := Start.h; yCoordinates^[1] := Start.v; nCoordinates := 1; end; {with info} if LOIType = Freehand then DoFreehand else DoPolygon(start); if nCoordinates > 1 then case LoiType of freehand: MakeNonStraightLineRoi(FreeLineRoi); segmented: MakeNonStraightLineRoi(SegLineRoi); end else with info^ do begin RoiShowing := false; RoiType := NoRoi; UpdatePicWindow; end; end; procedure DoProfilePlot (event: EventRecord); var ulength, clength: extended; begin with Info^ do begin WhatToUndo := NothingToUndo; measuring := false; DoObject(LineObj, event); RoiType := LineRoi; MakeRegion; RoiShowing := true; SetupUndo; GetLengthOrPerimeter(ulength, clength); if ulength > 0 then PlotDensityProfile end; end; procedure DoMouseDownInWindow (event: EventRecord; WhichWindow: WindowPtr); {Handles mouse down events in the content region of image windows.} var r: rect; str: str255; hloc, vloc: integer; tool: ToolType; start: Point; begin SetPort(info^.wptr); if Digitizing then if (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) then StopDigitizing; GlobalToLocal(event.where); IsInsertionPoint := false; with info^ do if RoiShowing then if EqualRect(RoiRect, PicRect) and (SelectionMode = NewSelection) then {if Select All} if not (OpPending and (CurrentOp = PasteOp)) then begin KillRoi; MouseState := NotInRoi; exit(DoMouseDownInWindow); end; if MouseState <> NotInRoi then exit(DoMouseDownInWindow); if SpaceBarDown and (CurrentTool <> TextTool) then tool := grabber else tool := CurrentTool; if (SelectionMode = NewSelection) and not ((tool = MagnifyingGlass) or (tool = Grabber)) then KillRoi; SetupUndo; case tool of SelectionTool: DoObject(SelectionRect, event); PolygonTool, FreehandTool: MakePolygon(event); OvalSelectionTool: DoObject(SelectionOval, event); LineTool: MakeLineRoi(event); MagnifyingGlass: ZoomIn(event); Grabber: Scroll(event); Pencil, Brush, Eraser: DoBrush(event); SprayCanTool: DoSprayCan; Ruler: if OptionKeyDown or ControlKeyDown then PutError('Use the line selection tool and Measure to measure path lengths.') else begin DoObject(LineObj, event); WhatToUndo := UndoEdit; end; PaintBucket: DoFill(event); TextTool: DoText(event.where); PlotTool: DoProfilePlot(event); PickerTool: if BitAnd(Event.modifiers, OptionKey) = OptionKey then GetBackgroundColor(event) else GetForegroundColor(event); CrossHairTool: DoPoints(event); AngleTool: FindAngle(event); Wand: begin if Digitizing then StopDigitizing; start := event.where; ScreenToOffscreen(start); AutoOutline(start); end; otherwise beep; end; end; procedure DoPopupMenusInTools; var Item: integer; ticks: LongInt; procedure DrawCurrentTool; begin InvalRect(ToolRect[CurrentTool]); BeginUpdate(ToolWindow); DrawTools; EndUpdate(ToolWindow); end; begin DrawCurrentTool; ticks := TickCount; repeat until (not button) or (TickCount > ticks + 20); if button and (TickCount > (ticks + 20)) then with ToolRect[CurrentTool] do begin Item := PopUpMenu(LineToolMenuH, left, top, ord(LOIType) + 1); case Item of 1: LOIType := Straight; 2: LOIType := Freehand; 3: LOIType := Segmented; otherwise end; DrawCurrentTool; end; end; procedure DoMouseDownInTools (loc: point); {Handles mouse down events in the tool palette.} var r: rect; OddTool, DoubleClick: boolean; ToolNum, i: integer; begin SetPort(ToolWindow); GlobalToLocal(loc); if loc.v <= StartOfLines then begin PreviousTool := CurrentTool; OddTool := loc.h < tmiddle; ToolNum := (loc.v div tmiddle) * 2; if not OddTool then ToolNum := ToolNum + 1; CurrentTool := ToolType(ToolNum); isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool) or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = LineTool); DoubleClick := (TickCount - ToolTime) < GetDblTime; ToolTime := TickCount; InvalRect(ToolRect[CurrentTool]); InvalRect(ToolRect[PreviousTool]); IsInsertionPoint := false; if DoubleClick and (CurrentTool = PreviousTool) then case CurrentTool of MagnifyingGlass: Unzoom; SelectionTool: begin StopDigitizing; SelectAll(true); end; SprayCanTool: SetSprayCanSize; Brush: SetBrushSize; LineTool: SetScale; PolygonTool: DoMeasurementOptions; FreehandTool: Calibrate; ruler: SetLineWidth; PlotTool: DoProfilePlotOptions; Eraser: if info <> NoInfo then begin KillRoi; SetupUndo; WhatToUndo := UndoClear; StopDigitizing; SelectAll(false); DoOperation(eraseOp); end; LutTool, Wand: if DensitySlicing then DisableDensitySlice else begin if Info^.Thresholding then ResetGrayMap; if OptionKeyDown then AutoDensitySlice; EnableDensitySlice; end; PickerTool: if info^.LutMode <> PseudoColor then begin {Switch to pseudocolor mode} DisableDensitySlice; UpdateLUT; CurrentTool := LutTool; isSelectionTool := false; InvalRect(ToolRect[CurrentTool]); end else ResetGrayMap; otherwise end; {case} if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) and (CurrentTool <> Wand) then KillRoi; if not DoubleClick and (CurrentTool = LineTool) then KillRoi; with info^ do if RoiShowing then if EqualRect(RoiRect, PicRect) and not isSelectionTool then {if Select All} KillRoi; if (CurrentTool = SelectionTool) or (CurrentTool = CrossHairTool) then begin InfoMessage := ''; if mCount > 0 then ShowInfo; end; RoiMode := MoveMode; if CurrentTool = LineTool then begin if Button then DoPopUpMenusInTools; if (LoiType = Straight) and (LineWidth <> 1) then begin LineWidth := 1; UpdateRoiLineWidth; ShowLineWidth; end; end; end else begin for i := 1 to nLineTypes do begin r := lines[i]; with r do begin left := left - 13; top := top - 2; right := right + 2; bottom := bottom + 2; end; if i = 1 then with r do top := top - 7; if PtInRect(loc, r) then begin with lines[i] do LineWidth := bottom - top; LineIndex := i; end; end; EraseRect(CheckRect); InvalRect(CheckRect); UpdateRoiLineWidth; end; end; procedure ScaleToFitScreen; var trect: rect; ignore: boolean; begin with info^ do begin MoveWindow(wptr, PicLeftBase, PicTopBase, true); SetRect(trect, 0, 0, ScreenWidth, ScreenHeight); ScaleImageWindow(trect); wrect := trect; SizeWindow(wptr, trect.right, trect.bottom, true); end; end; procedure DoDrag (WhichWindow: WindowPtr; loc: point); var WinRect, DragBounds, trect: rect; kind: integer; begin kind := WindowPeek(WhichWindow)^.WindowKind; if kind = PicKind then begin with info^ do begin {Save window location} GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; end; PicLeft := PicLeftBase; PicTop := PicTopBase; end; DragBounds := qd.ScreenBits.bounds; DragWindow(WhichWindow, loc, DragBounds); if (info^.PictureType = FrameGrabberType) or OptionKeyDown then begin GetWindowRect(WhichWindow, trect); MoveWindow(WhichWindow, band(trect.left, $fffc), trect.top, true); end; if WhichWindow = InfoWindow then ShowInfo; if WhichWindow = ResultsWindow then begin GetWindowRect(WhichWindow, trect); ResultsTop := trect.top; ResultsLeft := trect.left; end; end; procedure UpdateMenus; begin OptionKeyWasDown := OptionKeyDown; CurrentKind := CurrentWindow; UpdateFileMenu; UpdateEditMenu; UpdateOptionsMenu; UpdateTextItems; UpdateProcessMenu; UpdateAnalysisMenu; UpdateSpecialMenu; UpdateStacksMenu; UpdateWindowsMenu; end; function BalloonHelp: boolean; begin if not System7 then begin BalloonHelp := false; exit(BalloonHelp); end; BalloonHelp := HMGetBalloons; end; procedure DoMouseDown (event: EventRecord); {Handle mouse-down events} var WhichWindow: WindowPtr; ThePart, ignore, kind: integer; trect: rect; begin ThePart := FindWindow(event.where, WhichWindow); case ThePart of InDesk: ; InMenuBar: begin UpdateMenus; DoMenuEvent(MenuSelect(event.where)); end; InSysWindow: SystemClick(Event, WhichWindow); InContent: begin {The Tools, Map, LUT and PasteControl windows do not have to be activated to process the mouse-down event.} RoiUpdateTime := 0; if WhichWindow = ToolWindow then begin if BalloonHelp then SelectWindow(ToolWindow); DoMouseDownInTools(event.where); exit(DoMouseDown); end; if WhichWindow = MapWindow then begin if BalloonHelp then SelectWindow(MapWindow); DoMouseDownInMap; exit(DoMouseDown) end; if WhichWindow = LUTWindow then begin if BalloonHelp then SelectWindow(LUTWindow); DoMouseDownInLUT(event); exit(DoMouseDown) end; if WhichWindow = PasteControl then begin DoMouseDownInPasteControl(event.where); exit(DoMouseDown) end; if WhichWindow <> FrontWindow then begin {Image windows, text windows and the Result window must be activated if they are not the current window.} SelectWindow(WhichWindow); exit(DoMouseDown); end; if WhichWindow = ResultsWindow then begin DoMouseDownInResults(event.where); exit(DoMouseDown) end; kind := WindowPeek(WhichWindow)^.WindowKind; if Kind = TextKind then begin DoMouseDownInText(Event, WhichWindow); exit(DoMouseDown) end; if kind = PicKind then DoMouseDownInWindow(Event, WhichWindow); end; InDrag: DoDrag(WhichWindow, event.where); InGrow: DoGrow(WhichWindow, event); InGoAway: if TrackGoAway(WhichWindow, event.where) then if OptionKeyDown and (CurrentWindow = PicKind) then CloseAll else begin if WhichWindow <> VideoControl then StopDigitizing; ignore := CloseAWindow(WhichWindow); end; InZoomIn, InZoomOut: with info^ do case WindowState of NormalWindow: begin if digitizing then exit(DoMouseDown); ScaleToFit; if ScaleToFitWindow then ScaleToFitScreen; end; TiledSmall, TiledSmallScaled: begin if WindowState = TiledSmall then begin ScaleToFitWindow := true; WindowState := TiledBig; end else WindowState := TiledBigScaled; savewrect := wrect; SaveSrcRect := SrcRect; SaveMagnification := magnification; GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; ScaleToFitScreen; UpdatePicWindow; end; TiledBig: begin ScaleToFitWindow := false; WindowState := TiledSmall; wrect := savewrect; SrcRect := SaveSrcRect; magnification := SaveMagnification; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; magnification := 1.0; UpdateTitleBar; end; TiledBigScaled: begin WindowState := TiledSmallScaled; wrect := savewrect; SrcRect := PicRect; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; if PicRect.right <> 0 then magnification := wrect.right / PicRect.right; UpdateTitleBar; end; end; {case WindowState} end; {case thePart} end; procedure NudgeRoi (key: integer); var dh, dv: integer; begin with info^ do begin if not RoiShowing then exit(NudgeRoi); if OpPending and (CurrentOp <> PasteOp) then begin KillRoi; RestoreRoi; end; case key of LeftArrow: begin dh := -1; dv := 0 end; RightArrow: begin dh := 1; dv := 0 end; UpArrow: begin dh := 0; dv := -1 end; DownArrow: begin dh := 0; dv := 1 end; end; if OptionKeyDown then begin if RoiType = RectRoi then with RoiRect do begin right := right + dh; if right < left + 2 then right := left + 2; bottom := bottom + dv; if bottom < top + 2 then bottom := top + 2; MakeRegion; end else beep; end else begin OffsetRgn(roiRgn, dh, dv); RoiRect := roiRgn^^.rgnBBox; end; RoiNudged := true; RoiUpdateTime := 0; end; end; procedure DoKeyDown (event: EventRecord); var ch: char; ich, KeyCode: integer; begin Ch := chr(band(Event.message, CharCodeMask)); ich := ord(ch); {ShowMessage(long2str(ich));} KeyCode := bsr(band(Event.message, KeyCodeMask), 8); if BitAnd(Event.modifiers, CmdKey) = CmdKey then begin UpdateMenus; if OptionKeyWasDown then begin case KeyCode of 1: ch := 'S'; 3: ch := 'F'; 5: ch := 'G'; 8: ch := 'C'; 9: ch := 'V'; 13: ch := 'W'; 17: ch := 'T'; 24: ch := '='; 35: ch := 'P'; 44: ch := '/'; end; end; DoMenuEvent(MenuKey(Ch)); exit(DoKeyDown) end; if CurrentWindow = TextKind then begin DoKeyDownInText(ch); exit(DoKeyDown) end; with info^ do if (CurrentTool = TextTool) and IsInsertionPoint and (ord(ch) <> FunctionKey) then DrawCharacter(ch) else if ch = BackSpace then DoClear else if RoiShowing and (ich >= LeftArrow) and (ich <= DownArrow) then NudgeRoi(ich) else if (StackInfo <> nil) and (ch in ['<', ',', chr(PageUp), '>', '.', chr(PageDown), chr(HomeKey), chr(EndKey)]) then begin if ch in ['<', ',', chr(PageUp)] then ShowNextSlice(PreviousSliceItem) else if ch in ['>', '.', chr(PageDown)] then ShowNextSlice(NextSliceItem) else if (ich = HomeKey) or (ich = EndKey) then ShowFirstOrLastSlice(ich); end else if nMacros > 0 then RunKeyMacro(ch, KeyCode); end; procedure DoActivate (event: EventRecord); var WhichWindow: WindowPtr; Activating, SwitchingWindows, isOK: boolean; I, kind: integer; NewInfo: InfoPtr; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; Activating := odd(event.modifiers); case kind of PicKind: begin if Activating then begin NewInfo := pointer(WindowPeek(WhichWindow)^.RefCon); SwitchingWindows := NewInfo <> Info; if SwitchingWindows then begin StopDigitizing; SaveRoi; DisableDensitySlice; end; Info := NewInfo; if SwitchingWindows then ActivateWindow; Measuring := false; with info^ do begin LoadLUT(cTable); DrawMap; if digitizing and HighlightSaturatedPixels then HighlightPixels; GenerateValues; if fit = uncalibrated then DrawLabels('', '', ''); end; {with} end else KillOperation; {Deactivate} end; ResultsKind: UpdateResultsWindow; TextKind: ActivateTextWindow(WhichWindow, Activating); otherwise end; {case} if not activating then begin WhichWindow := FrontWindow; if WhichWindow <> nil then begin kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then ConverToSystemClipboard; {DA has become active} end; end; end; procedure DoUpdate (event: EventRecord); var WhichWindow: WindowPtr; SaveInfo: InfoPtr; kind: integer; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; BeginUpdate(WhichWindow); case kind of Pickind: begin SaveInfo := info; Info := pointer(WindowPeek(WhichWindow)^.RefCon); if not digitizing then begin UpdatePicWindow; DrawMyGrowIcon(info^.wptr); end; info := SaveInfo; end; ToolKind: DrawTools; MapKind: DrawMap; LutKind: DrawLUT; InfoKind: begin DrawLabels('', '', ''); if (mCount > 0) or (InfoMessage <> '') then ShowInfo; end; HistoKind: DrawHistogram; ProfilePlotKind, CalibrationPlotKind: UpdatePlotWindow; ResultsKind: UpdateResultsWindow; PasteControlKind: DrawPasteControl; TextKind: UpdateTextWindow(WhichWindow); end; EndUpdate(WhichWindow); end; procedure DoDiskInsert (event: EventRecord); { Process disk insertion event, check for damaged or uninitialized disks. } var p: point; intjunk: integer; begin if (HiWrd(event.message) <> NoErr) then begin DiLoad; SetPt(p, 100, 80); intjunk := DiBadMount(p, event.message); DiUnload; end; end; procedure DoDialogEvent (event: EventRecord); {Handles modeless dialog box events} var isItemHit: boolean; theDialog: DialogPtr; ItemHit: integer; ch: char; begin if (Event.what = KeyDown) and (BitAnd(Event.modifiers, CmdKey) = CmdKey) then begin UpdateMenus; ch := chr(band(Event.message, CharCodeMask)); DoMenuEvent(MenuKey(ch)); exit(DoDialogEvent); end; isItemHit := DialogSelect(event, theDialog, ItemHit); if isItemHit and (theDialog = VideoControl) then DoVideoControl(ItemHit); end; function MyGotRequiredParams(var theAppleEvent:AppleEvent):OSErr; var err:OSErr; returnedType:DescType; actualSize:Size; begin err:=AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType, nil, 0, actualSize); if err=errAEDescNotFound then myGotRequiredParams:=noErr else if err=noErr then myGotRequiredParams:=errAEParamMissed; end; procedure PrintDocument; begin UpdatePicWindow; WhatToPrint := PrintImage; Print(false); DoClose; end; function OpenFinderFile(myFSS:FSSpec; PrintDoc:boolean):OSErr; var theInfo: FInfo; err, err1, err2:OSErr; wdRefNum, f:integer; okay:boolean; begin OpenFinderFile:=fnfErr; with myFSS do begin err := OpenWD(VRefNum, parID, 0, wdRefNum); if err<>noErr then exit(OpenFinderFile); err := GetFInfo(name, wdRefNum, theInfo); if err<>noErr then exit(OpenFinderFile); okay:=false; OpeningFinderFiles:=true; if theInfo.fdType = 'TIFF' then begin WhatToOpen := OpenTIFF; okay := OpenFile(name, wdRefNum); if OpeningRGB then begin if okay then ConvertRGBToEightBitColor(true); OpeningRGB := false; end; if PrintDoc then PrintDocument; end; if theInfo.fdType = 'PICT' then begin okay := OpenPICT(name, wdRefNum, false); if PrintDoc then PrintDocument; end; if theInfo.fdType = 'TEXT' then begin okay := OpenTextFile(name, wdRefNum); end; if theInfo.fdType = 'PICS' then begin okay := OpenPICS(name, wdRefNum); end; if theInfo.fdType = 'Iout' then begin OpenOutline(name, wdRefNum); okay:=true; end; if theInfo.fdType = 'ICOL' then begin OpenColorTable(name, wdRefNum); okay:=true; end; if theInfo.fdType = 'IPIC' then begin WhatToOpen := OpenImage; okay := OpenFile(name, wdRefNum); if PrintDoc then PrintDocument; end; if (theInfo.fdType = 'PREF') or (theInfo.fdType = 'pref') then begin err := fsopen(name, wdRefNum, f); GetPreferences(f); if nExtraColors > 0 then RedrawLUTWindow; if InvertPixelValues then InvertGrayLevels; end; OpeningFinderFiles:=false; if okay then OpenFinderFile:=noErr; end; end; function HandleOpenOrPrint(var theAppleEvent, reply:AppleEvent; RefCon:LongInt; PrintDoc:boolean):OSerr; var err, ignoreErr:OSErr; docList:AEDescList; index, ItemsInList:LongInt; actualSize:Size; keywd:AEKeyword; returnedType:DescType; myFSS:FSSpec; begin err:=AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList); if err=noErr then begin err:=myGotRequiredParams(theAppleEvent); if err=noErr then begin err:=AECountItems(docList, itemsInList); if err=noErr then for index:=1 to ItemsInList do begin err:=AEGetNthPtr(docList, index, typeFSS, keywd, returnedType, @myFSS, SizeOf(myFSS), actualSize); if err=noErr then begin err:=OpenFinderFile(myFSS, PrintDoc); end; end; end; ignoreErr:=AEDisposeDesc(docList); end; HandleOpenOrPrint:=err; end; function HandleOpenApp(var theAppleEvent, reply:AppleEvent; RefCon:LongInt):OSerr; begin HandleOpenApp:=noErr; end; function HandleOpenDoc(var theAppleEvent, reply:AppleEvent; RefCon:LongInt):OSerr; begin HandleOpenDoc:=HandleOpenOrPrint(theAppleEvent, reply, RefCon, false); end; function HandlePrintDoc(var theAppleEvent, reply: AppleEvent; RefCon:LongInt):OSerr; begin HandlePrintDoc:=HandleOpenOrPrint(theAppleEvent, reply, RefCon, true); end; function HandleQuit(var theAppleEvent, reply:AppleEvent; RefCon:LongInt):OSerr; begin Finished:=true; HandleQuit:=noErr; end; function HandleEvents: boolean; const mousemovedmessage = $FA; SuspendResumeMessage = 1; ResumeMask = 1; var Event: EventRecord; result: boolean; theDialog: DialogPtr; ItemHit: integer; SleepTicks: LongInt; okay: boolean; err:OSErr; begin if Digitizing then SleepTicks := 0 else SleepTicks := 2; if WaitNextEvent(EveryEvent, Event, SleepTicks, nil) then begin if isDialogEvent(event) then DoDialogEvent(event) else case Event.what of KeyDown, AutoKey: DoKeyDown(Event); MouseDown: DoMouseDown(Event); ActivateEvt: DoActivate(Event); DiskEvt: DoDiskInsert(Event); UpdateEvt: DoUpdate(Event); osEvt: case BSR(event.message, 24) of MouseMovedMessage: ; SuspendResumeMessage: if BAND(event.message, ResumeMask) <> 0 then begin{Resume event} if SwitchLUTOnSuspend and (WhatToUndo = UndoLUT) then begin UndoLUTChange; WhatToUndo := NothingToUndo; end else LoadLUT(info^.ctable); end else begin {Suspend event} KillOperation; ConverToSystemClipboard; if SwitchLUTOnSuspend then begin SetupLUTUndo; okay := LoadCLUTResource(AppleDefaultCLUT); end; end; end; kHighLevelEvent: err:=AEProcessAppleEvent (Event); otherwise {Do nothing} end; {case} HandleEvents := true end else HandleEvents := false; end; procedure ShowInsertionPoint; var tRect: rect; Loc: point; height, imag: integer; begin if (not isInsertionPoint) or (info = NoInfo) then exit(ShowInsertionPoint); if CurrentWindow <> PicKind then exit(ShowInsertionPoint); if (TickCount mod (BlinkTime * 2)) < BlinkTime then exit(ShowInsertionPoint); Loc := InsertionPoint; OffscreenToScreen(loc); with info^, tRect do begin SetPort(wptr); imag := trunc(magnification + 0.5); height := CurrentSize * imag; height := height - height div 4; left := loc.h; bottom := loc.v - imag + 1; top := bottom - height; right := left + 1; PenNormal; PenSize(imag, imag); PenMode(PatXor); FrameRect(tRect); ipTicks := TickCount + 3; repeat until TickCount > ipTicks; FrameRect(tRect); end; end; procedure UndoRoi; var SrcPtr, DstPtr: ptr; offset, ByteCount, tTop, tBottom: LongInt; tRect: rect; begin with info^ do begin if PixMapSize <> CurrentUndoSize then exit(UndoRoi); tRect := RoiRect; if RoiType = LineRoi then InsetRect(tRect, -RoiHandleSize, -RoiHandleSize); with tRect do begin tTop := top; tBottom := bottom; if tTop < 0 then tTop := 0; if tTop > PicRect.bottom then tTop := PicRect.bottom; if tBottom < 0 then tBottom := 0; if tBottom > PicRect.bottom then tBottom := PicRect.bottom; end; offset := tTop * BytesPerRow; if offset < 0 then offset := 0; SrcPtr := ptr(ord4(UndoBuf) + offset); DstPtr := ptr(ord4(PicBaseAddr) + offset); ByteCount := (tBottom - tTop) * BytesPerRow; BlockMove(SrcPtr, DstPtr, ByteCount); end; end; procedure GetLineHandles (var LeftHandle, MiddleHandle, RightHandle: rect); var offset1, offset2, xcenter, ycenter, x1, y1, x2, y2: integer; rx1, ry1, rx2, ry2: extended; begin offset1 := RoiHandleSize div 2; offset2 := offset1 + 1; GetLoi(rx1, ry1, rx2, ry2); x1 := trunc(rx1); y1 := trunc(ry1); x2 := trunc(rx2); y2 := trunc(ry2); SetRect(LeftHandle, x1 - offset1, y1 - offset1, x1 + offset2, y1 + offset2); with info^.RoiRect do begin xcenter := left + (right - left) div 2; ycenter := top + (bottom - top) div 2; end; SetRect(MiddleHandle, xcenter - offset1, ycenter - offset1, xcenter + offset2, ycenter + offset2); SetRect(RightHandle, x2 - offset1, y2 - offset1, x2 + offset2, y2 + offset2); end; procedure DrawROI; var tRect: rect; RoiHandle, LeftHandle, MiddleHandle, RightHandle: rect; psize: integer; StartTicks: LongInt; SaveGDevice: GDHandle; begin with Info^ do begin StartTicks := TickCount; if OpPending then DoOperation(CurrentOp); SaveGDevice := GetGDevice; SetGDevice(osGDevice); SetPort(GrafPtr(Info^.osPort)); PenNormal; if ScaleToFitWindow then if (magnification < 1.0) and (magnification <> 0.0) then begin psize := round(1.0 / magnification + 1.5); PenSize(psize, psize); end; if not ((MouseState = DownInRoi) and OpPending) then if PixMapSize <= UndoBufSize then begin pmForeColor(BlackIndex); pmBackColor(WhiteIndex); case RoiType of RectRoi: with RoiRect do begin SetRect(RoiHandle, right - RoiHandleSize, bottom - RoiHandleSize, right, bottom); if ((right - left) > RoiHandleSize) and ((bottom - top) > RoiHandleSize) then PaintRect(RoiHandle); end; LineRoi: if Magnification <= 2.0 then begin GetLineHandles(LeftHandle, MiddleHandle, RightHandle); PaintRect(LeftHandle); if LineWidth < 4 then PaintRect(MiddleHandle); PaintRect(RightHandle); pmForeColor(WhiteIndex); FrameRect(LeftHandle); if LineWidth < 4 then FrameRect(MiddleHandle); FrameRect(RightHandle); pmForeColor(BlackIndex); end; otherwise end; PatIndex := (PatIndex + 1) mod 8; PenPat(AntPattern[PatIndex]); FrameRgn(roiRgn); pmForeColor(ForegroundIndex); pmBackColor(BackgroundIndex); end; if PixMapSize > UndoBufSize then begin if magnification < 1.0 then PenSize(2, 2); PatIndex := (PatIndex + 1) mod 8; PenPat(AntPattern[PatIndex]); PenMode(PatXor); FrameRgn(roiRgn); if MouseState = DownInRoi then begin UnionRect(RoiRect, OldRoiRect, tRect); UpdateScreen(tRect); end else UpdateScreen(RoiRect); FrameRgn(roiRgn); end else begin tRect := RoiRect; if MouseState = DownInRoi then UnionRect(RoiRect, OldRoiRect, tRect) else if RoiNudged then begin tRect := RoiRect; RoiNudged := false; end; if RoiType = LineRoi then InsetRect(tRect, -RoiHandleSize * 2, -RoiHandleSize * 2) else InsetRect(tRect, -2, -2); UpdateScreen(tRect); UndoRoi; {Erase offscreen ROI} end; RoiUpdateTime := TickCount - StartTicks; end; {with} SetGDevice(SaveGDevice); end; procedure MoveLineEndPoint (osloc: point); var deltax, deltay: extended; begin with info^, osloc, info^.RoiRect do begin if h < 0 then h := 0; if h > PicRect.right then h := PicRect.right; if v < 0 then v := 0; if v > PicRect.bottom then v := PicRect.bottom; if RoiMode = LeftEndMode then begin LX1 := h; LY1 := v; LX2 := left + LX2; LY2 := top + LY2; end else begin LX2 := h; LY2 := v; LX1 := left + LX1; LY1 := top + LY1; end; if ShiftKeyDown then begin deltax := LX2 - LX1; deltay := LY2 - LY1; if abs(deltax) > abs(deltay) then begin if RoiMode = LeftEndMode then LY2 := LY1 else LY1 := LY2 end else begin if RoiMode = LeftEndMode then LX2 := LX1 else LX1 := LX2 end; end; {if ShiftKeyDown} MakeRegion; osMouseDownLoc := osloc; RoiUpdateTime := 0; Show3Values(h, v, MyGetPixel(h, v)); end; end; procedure MoveRoi (osloc: point); var dh, dv: integer; begin with info^, info^.RoiRect, osloc do begin dh := h - osMouseDownLoc.h; dv := v - osMouseDownLoc.v; OldRoiRect := RoiRect; if RoiType = LineRoi then if (RoiMode = LeftEndMode) or (RoiMode = RightEndMode) then begin MoveLineEndPoint(osloc); exit(MoveRoi); end; if RoiMode = MoveMode then begin if RoiMovementState = Constrained then begin if dv <> 0 then RoiMovementState := ConstrainedV else if dh <> 0 then RoiMovementState := ConstrainedH end; if RoiMovementState = ConstrainedH then dv := 0 else if RoiMovementState = ConstrainedV then dh := 0; if not OpPending then begin if left + dh < 0 then dh := -left; if top + dv < 0 then dv := -top; end; end; if not OpPending then begin if right + dh > PicRect.right then dh := PicRect.right - right; if bottom + dv > PicRect.bottom then dv := PicRect.bottom - bottom; end; if RoiMode = StretchMode then begin measuring := false; DrawLabels('Width:', 'Height:', ''); if h > left then begin right := right + dh; if right < (left + 1) then right := left + 1; if (right - h) > 5 then right := h + 2; end else right := left + 1; if v > top then begin bottom := bottom + dv; if bottom < (top + 1) then bottom := top + 1; if (bottom - v) > 5 then bottom := v + 2; end else bottom := top + 1; Show3Values(right - left, bottom - top, -1); MakeRegion; end else begin OffsetRgn(roiRgn, dh, dv); Show3Values(left, top, MyGetPixel(left, top)); end; RoiRect := roiRgn^^.rgnBBox; osMouseDownLoc := osloc; RoiUpdateTime := 0; {Forces ROI outline to be redrawn} end; {with Info} end; procedure ShowHistogramValues (GrayLevel: LongInt); var hstart, vstart, ivalue: integer; begin hstart := InfoHStart; vstart := InfoVStart; SetPort(InfoWindow); TextSize(9); TextFont(Monaco); TextMode(SrcCopy); MoveTo(xValueLoc, vstart); with info^ do if fit = uncalibrated then DrawLong(GrayLevel) else begin if InvertingCalibrationFunction then DrawReal(cvalue[255 - GrayLevel], 8, 2) else DrawReal(cvalue[GrayLevel], 8, 2); DrawString(' ('); DrawLong(GrayLevel); DrawString(' )'); end; DrawString(' '); MoveTo(yValueLoc, vstart + 10); if InvertingCalibrationFunction then DrawLong(histogram[255 - GrayLevel]) else DrawLong(histogram[GrayLevel]); DrawString(' '); end; procedure DoPlotCursor (loc: point; kind: integer); var xxscale, angle: extended; xvalue, xinc, yinc: integer; pt: point; begin DrawLabels('X:', 'Y:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(PlotWindow); GlobalToLocal(loc); xxscale := PlotCount / (PlotWidth - PlotRightMargin - PlotLeftMargin); xvalue := trunc((loc.h - PlotLeftMargin) * xxscale); if (xvalue < 0) or (xvalue >= PlotCount) then exit(DoPlotCursor); Show2PlotValues(xvalue, PlotData^[xvalue]); if (kind = CalibrationPlotKind) or (info^.RoiType <> LineRoi) then exit(DoPlotCursor); if button and (info <> NoInfo) then with loc do begin SetPort(info^.wptr); PenMode(PatXor); PenSize(1, 1); angle := (PlotAngle / 180.0) * pi; xinc := round(cos(angle) * xvalue); yinc := round(-sin(angle) * xvalue); h := PlotStart.h + xinc; v := PlotStart.v + yinc; OffscreenToScreen(loc); MoveTo(h - 7, v); LineTo(h + 7, v); MoveTo(h, v - 7); LineTo(h, v + 7); wait(2); MoveTo(h - 7, v); LineTo(h + 7, v); MoveTo(h, v - 7); LineTo(h, v + 7); end; end; procedure SelectCursor; var loc, osloc, gloc: point; where, kind, i, color, x, y, margin: integer; WhichWindow: WindowPtr; MouseInRoi: boolean; fwptr: WindowPtr; CalValue: extended; RoiStretchHandle, LeftHandle, MiddleHandle, RightHandle: rect; MovingRoi: boolean; pvalue: integer; begin if PasteControl <> nil then begin fwptr := FrontWindow; if fwptr <> nil then if WindowPeek(fwptr)^.WindowKind <> PasteControlKind then BringToFront(PasteControl); end; SetPort(ScreenPort); GetMouse(gloc); loc := gloc; where := FindWindow(gloc, WhichWindow); if WhichWindow = nil then begin InitCursor; exit(SelectCursor) end; kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then exit(SelectCursor); {System Window} if where <> InContent then begin InitCursor; exit(SelectCursor) end; case kind of PicKind: begin if Info = NoInfo then begin InitCursor; exit(SelectCursor) end; SetPort(info^.wptr); GlobalToLocal(loc); osloc := loc; ScreenToOffscreen(osloc); MovingRoi := false; with info^ do begin SelectionMode := NewSelection; if RoiShowing and ((isSelectionTool) or (CurrentTool = Wand)) and (currentTool <> LineTool) then begin if OptionKeyDown then SelectionMode := SubSelection else if ControlKeyDown or (ShiftKeyDown and (CurrentTool <> OvalSelectionTool) and (CurrentTool <> SelectionTool)) then SelectionMode := AddSelection; end; if RoiShowing and (SelectionMode = NewSelection) then begin MouseInRoi := PtInRgn(osloc, roiRgn); if RoiType = LineRoi then begin GetLineHandles(LeftHandle, MiddleHandle, RightHandle); if magnification <= 2.0 then begin InsetRect(LeftHandle, -2, -2); InsetRect(MiddleHandle, -2, -2); InsetRect(RightHandle, -2, -2); end; MouseInRoi := MouseInRoi or PtInRect(osloc, LeftHandle) or MouseInRoi or PtInRect(osloc, MiddleHandle) or MouseInRoi or PtInRect(osloc, RightHandle); end; end else MouseInRoi := false end; {with} if MouseInRoi or (MouseState = DownInRoi) then begin if MouseState = NotInRoi then MouseState := InRoi; InitCursor; if button then begin if MouseState = InRoi then begin if OpPending and (CurrentOp <> PasteOp) then SetupUndo; MouseState := DownInRoi; osMouseDownLoc := osloc; with info^ do case RoiType of RectRoi: begin if magnification > 1.0 then margin := 0 else margin := 2; with RoiRect do SetRect(RoiStretchHandle, right - RoiHandleSize - margin, bottom - RoiHandleSize - margin, right, bottom); if PtInRect(osloc, RoiStretchHandle) then RoiMode := StretchMode else RoiMode := MoveMode; end; LineRoi: if PtInRect(osloc, LeftHandle) then RoiMode := LeftEndMode else if PtInRect(osloc, RightHandle) then RoiMode := RightEndMode else RoiMode := MoveMode; otherwise end; {case} if ShiftKeyDown then RoiMovementState := Constrained else RoiMovementState := Unconstrained; end; MoveRoi(osloc); MovingRoi := true; end else MouseState := InRoi end else begin MouseState := NotInRoi; if SpaceBarDown and (CurrentTool <> TextTool) then SetCursor(ToolCursor[Grabber]) else if (SelectionMode = AddSelection) and (CurrentTool = Wand) then SetCursor(WandPlusCursor) else if (SelectionMode = SubSelection) and (CurrentTool = Wand) then SetCursor(WandMinusCursor) else if SelectionMode = AddSelection then SetCursor(CrossPlusCursor) else if SelectionMode = SubSelection then SetCursor(CrossMinusCursor) else if (CurrentTool = MagnifyingGlass) and OptionKeyDown then SetCursor(GlassMinusCursor) else SetCursor(ToolCursor[CurrentTool]); end; if not MovingRoi then begin if isFFT then begin DrawLabels('r:', 'theta:', 'Value:'); with osloc do ShowFFTValues(h, v, MyGetPixel(h, v)); exit(SelectCursor); end; if CurrentTool = PickerTool then DrawLabels('X:', 'Y:', 'RGB:') else DrawLabels('X:', 'Y:', 'Value:'); with osloc do begin if Digitizing then pvalue := GetFGPixel(h, v) else pvalue := MyGetPixel(h, v); Show3Values(h, v, pvalue); end; end; end; HistoKind: begin DrawLabels('Level:', 'Count:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(HistoWindow); GlobalToLocal(loc); ShowHistogramValues(loc.h); end; ProfilePlotKind, CalibrationPlotKind: DoPlotCursor(loc, kind); LUTKind: begin if info^.fit <> uncalibrated then DrawLabels('Index:', 'Value:', ' RGB:') else DrawLabels('Index:', ' RGB:', ''); SetPort(LUTWindow); GlobalToLocal(loc); if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin if loc.v < 256 then SetCursor(LUTCursor) else InitCursor end else SetCursor(PickerCursor); if loc.v < 256 then begin ShowRGBValues(loc.v); end else begin color := 0; for i := 1 to nExtraColors + 2 do if PtInRect(loc, ExtraColorsRect[i]) then Color := ExtraColorsEntry[i]; ShowRGBValues(color); end; end; MapKind: if OptionKeyDown then SetCursor(ToolCursor[SelectionTool]) else SetCursor(gmCursor); TextKind: begin TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); if TextInfo <> nil then with TextInfo^ do begin SetPort(TextWindowPtr); GlobalToLocal(loc); TEIdle(TextTE); with TextWindowPtr^.portRect do begin if (loc.h < (right - ScrollBarWidth)) and (loc.v < (bottom - ScrollBarWidth)) then SetCursor(ToolCursor[TextTool]) else InitCursor; end; end; end; otherwise InitCursor; end; {case} end; procedure CloseAll; var i, j, result: integer; WPeek, NextWPeek: WindowPeek; ignore: boolean; begin InitCursor; WPeek := WindowPeek(FrontWindow); StopDigitizing; while wpeek <> nil do begin NextWPeek := WPeek^.NextWindow; case wPeek^.WindowKind of PicKind: begin Info := pointer(WPeek^.RefCon); result := CloseAWindow(info^.wptr); if not CommandPeriod then for j := 1 to 2 do ignore := HandleEvents; if result = cancel then begin ActivateWindow; finished := false; exit(CloseAll) end; end; TextKind: begin result := CloseAWindow(WindowPtr(wPeek)); if result = cancel then begin finished := false; exit(CloseAll) end; end; otherwise ; end; {case} wpeek := NextWPeek; end; end; procedure LoadDefaultMacros; {Looks for a text file named "Image Macros" in the same folder as} {Image, and, if found, loads the macros contained in it.} var err: OSErr; LaunchRefNum: integer; FinderInfo: FInfo; id: LongInt; begin err := GetVol(nil, LaunchRefNum); if err = noerr then err := GetFInfo('Image Macros', LaunchRefNum, FinderInfo); if err = NoErr then begin LoadMacrosFromFile('Image Macros', LaunchRefNum); {$ifc not PowerPC} UnloadSeg(@LoadMacros); {$endc} end; end; procedure Shutdown; var AlertID: integer; begin if (UnsavedResults and (mCount > 10)) or (UnsavedResults and (ResultsWindow <> nil)) then begin InitCursor; AlertID := alert(500, nil); if AlertID = CancelResetID then begin finished := false; exit(Shutdown) end; end; CloseAll; if finished then ConverToSystemClipboard; end; procedure InstallEventHandlers; {Installs event handlers for the four required Apple Events.} var err:OSErr; begin err:=AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, NewAEEventHandlerProc(@HandleOpenApp), 0, false); err:=AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, NewAEEventHandlerProc(@HandleOpendoc), 0, false); err:=AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, NewAEEventHandlerProc(@HandlePrintDoc), 0, false); err:=AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, NewAEEventHandlerProc(@HandleQuit), 0, false); end; begin Init; InstallEventHandlers; SetupMenus; {GetSettings moved to Init} AllocateBuffers; AllocateArrays; ConvertFromSystemClipboard; LoadDefaultMacros; FindPlugIns; {$ifc not PowerPC} UnloadSeg(@Init); {$endc} {InitUser;} repeat if not HandleEvents then if info^.RoiShowing and (RoiUpdateTime < 30) then DrawRoi; ShowInsertionPoint; SelectCursor; if Digitizing then begin CaptureAndDisplayFrame; if ContinuousHistogram then ShowContinuousHistogram; end; if Finished then Shutdown; until finished; CloseSerialPorts; isOK := LoadCLUTResource(AppleDefaultCLUT); RestoreScreen; {Force Finder to redraw color icons} end.